home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 038a / aplibs91.zip / COLORSET.BAS < prev    next >
BASIC Source File  |  1990-12-09  |  12KB  |  351 lines
  1.  
  2. '[74017,2570]
  3. 'COLRSE.ZIP/binary         06-Dec-90 4608               Accesses: 4
  4. '
  5. '    Title   : COLORSET - PB program to set program colors /APLIB
  6. '    Keywords: COLORSET APLIB HOWARD BALLINGER
  7. '
  8. '    Colorset is an update to Howard Ballingers COLORSET. This has been enhanced
  9. '    to change colors interactively, allowing you to see what effect it will
  10. '    have on screen appearance <before> you select your color choice. Also, a
  11. '    wrap-around feature has been added to the color chart (thanks, Barry) so
  12. '    that when you reach the borders of the chart it will just wrap.
  13.      
  14.  
  15.  DEFINT A-Z
  16.  CLS
  17.  ScrColor = &H02
  18.  BoxColor = &H4E
  19.  
  20.  LOCATE ,,0
  21.  
  22. '   Code to write Static Window {colorset} to Screen
  23. '        note: created by StatWindow Writer (SWW) from colorset.SW
  24.  
  25.  COLOR BoxColor MOD 16, BoxColor \ 16
  26.  LOCATE  3, 1
  27.  PRINT  "┌───────────────────────────────────────────────────────────────────┐"
  28.  PRINT  "│                                                                   │";
  29.  PRINT  "│     COLORSET is a part of the HB All-Purpose library for Power    │";
  30.  PRINT  "│     Basic programming. One of the features included is making     │";
  31.  PRINT  "│     your PB programs color-customizable by the end user.          │";
  32.  PRINT  "│     COLORSET.BAS, once compiled,  automates the process of        │";
  33.  PRINT  "│     writing command line switches to reset the colors of the      │";
  34.  PRINT  "│     Demo (or any PB program that uses the SetColors routine).     │";
  35.  PRINT  "│     Start it and follow directions! The program will end up       │";
  36.  PRINT  "│     writing a batch file (name is entered at runtime) to start    │";
  37.  PRINT  "│     a PB exe file (likewise) in the colors chosen onscreen.       │";
  38.  PRINT  "│                                                                   │";
  39.  PRINT  "│         (Thanks to Barry Erick of Spectra support for giving his  │";
  40.  PRINT  "│     OK to recycle his elegant color selector procedure as the     │";
  41.  PRINT  "│     kernel of COLORSET.)                                          │";
  42.  PRINT  "│                                             -- Howard Ballinger   │";
  43.  PRINT  "│                                                    9-8-90         │";
  44.  PRINT  "│      PRESS ANY KEY                                                │";
  45.  PRINT  "│      [Esc] to Quit                                                │";
  46.  PRINT  "└───────────────────────────────────────────────────────────────────┘";
  47.  
  48. '  09-08-1990, 11:13:   end of StatWindow generated code for window {colorset}
  49.  
  50.  COLOR ScrColor MOD 16, ScrColor \ 16
  51.  DO: K$ = INKEY$: LOOP UNTIL K$ <> ""
  52.  IF K$ = CHR$ (27) THEN PRINT: PRINT: PRINT "OK, Ending Here.": STOP
  53.  
  54.  ScrColor = &H02
  55.  WinColor = &H71
  56.  FldColor = &H2F
  57.  MenuColor = &H03
  58.  BarColor = &H1F
  59.  BoxColor = &H3A
  60.  
  61. Start:
  62.  CLS
  63.  CALL ShowBG(ScrColor MOD 16, ScrColor \ 16)
  64.  CALL ShowMenu(MenuColor MOD 16, MenuColor \ 16)
  65.  CALL ShowMenuBar(BarColor MOD 16, BarColor \ 16)
  66.  CALL ShowWin(WinColor MOD 16, WinColor \ 16)
  67.  CALL Showdata(FldColor MOD 16, FldColor \ 16)
  68.  CALL ShowMssgBox(BoxColor MOD 16, BoxColor \ 16)
  69.  COLOR ScrColor MOD 16, ScrColor \ 16
  70.  LOCATE 2,20: PRINT "COLOR SELECT FOR HB / POWER BASIC PROGRAMS"
  71.  LOCATE 3,21: PRINT "========================================"
  72.  
  73.  LOCATE 24,1
  74.  COLOR 15,0
  75.  PRINT "  1: Menu / 2: Menu Select Bar / 3: Window / 4: Data Fields in Window        ";
  76.  LOCATE 25,1
  77.  PRINT "     5: Message-Dialog Boxes / 6: Screen Background & Buttons / [Esc]: QUIT   ";
  78.  
  79.  LOCATE 23,1,1: COLOR 14,0: PRINT "Which color do you want to set ? ";
  80.  DO
  81.    Choice$ = INKEY$
  82.    IF Choice$ = "" THEN Choice$ = "0"
  83.  LOOP UNTIL (INSTR ("123456", Choice$) >  0) OR Choice$ = CHR$(27)
  84.  
  85.  LOCATE 23,1,0: PRINT "                                       "
  86.  LOCATE 24,1: PRINT SPACE$ (79);
  87.  LOCATE 25,1: PRINT SPACE$ (79);
  88.  SELECT CASE Choice$
  89.    CASE "1"
  90.       LOCATE 24,10: COLOR 31,0: PRINT "SELECT YOUR MENU COLOR";
  91.       F = MenuColor MOD 16: B = MenuColor \ 16
  92.       GOSUB GetChoice
  93.       MenuColor = F + 16*B
  94.       EXIT SELECT
  95.    CASE "2"
  96.       LOCATE 24,10: COLOR 31,0: PRINT "SELECT YOUR MENU SELECTION BAR COLOR";
  97.       F = BarColor MOD 16: B = BarColor \ 16
  98.       GOSUB GetChoice
  99.       BarColor = F + 16*B
  100.       EXIT SELECT
  101.    CASE "3"
  102.       LOCATE 24,10: COLOR 31,0: PRINT "SELECT YOUR DATA ENTRY WINDOW COLOR";
  103.       F = WinColor MOD 16: B = WinColor \ 16
  104.       GOSUB GetChoice
  105.       WinColor = F + 16*B
  106.       EXIT SELECT
  107.    CASE "4"
  108.       LOCATE 24,10: COLOR 31,0: PRINT "SELECT YOUR DATA ENTRY FIELD COLOR";
  109.       F = FldColor MOD 16: B = FldColor \ 16
  110.       GOSUB GetChoice
  111.       FldColor = F + 16*B
  112.       EXIT SELECT
  113.    CASE "5"
  114.       LOCATE 24,10: COLOR 31,0: PRINT "SELECT YOUR MESSAGE / DIALOG BOX COLOR";
  115.       F = BoxColor MOD 16: B = BoxColor \ 16
  116.       GOSUB GetChoice
  117.       BoxColor = F + 16*B
  118.       EXIT SELECT
  119.    CASE "6"
  120.       LOCATE 24,10: COLOR 31,0
  121.       PRINT "SELECT YOUR OVERALL SCREEN & BUTTON COLOR";
  122.       F = ScrColor MOD 16: B = ScrColor \ 16
  123.       GOSUB GetChoice
  124.       ScrColor = F + 16*B
  125.       EXIT SELECT
  126.    CASE CHR$ (27)
  127.       LOCATE 5,1
  128.       L$ = "ScrC="+FnHEX2$ (ScrColor)+_
  129.        " MnuC="+FnHEX2$ (MenuColor)+_
  130.        " BarC="+FnHEX2$ (BarColor)+_
  131.        " WinC="+FnHEX2$ (WinColor)+_
  132.        " FldC="+ FnHEX2$ (FldColor)+_
  133.        " BoxC="+FnHEX2$ (BoxColor)
  134.       PRINT "the parameter string is: ";L$
  135.       COLOR ScrColor MOD 16, ScrColor \ 16
  136. PrepareBatFile:
  137.       LOCATE 6,1
  138.       PRINT "  IF YOU WANT TO CREATE A BATCH FILE, ENTER ITS NAME (no ext) "
  139.       INPUT "      (TO SKIP, JUST PRESS [ENTER]). FileName ";BatName$
  140.       IF BatName$ <> "" THEN
  141.         P = INSTR (BatName$, ".")
  142.         IF P THEN BatName$ = LEFT$ (BatName$, P-1)
  143.         BatName$ = UCASE$ (LEFT$ (BatName$, 8))
  144.         LOCATE 8,1
  145.         PRINT "  NAME OF POWER-BASIC EXE PROGRAM TO BE STARTED IN NEW COLORS"
  146.         PRINT "    BY THE BATCH FILE ";BatName$ + ".BAT ?? (no ext) ";
  147.         INPUT ExeName$
  148.         P = INSTR (ExeName$, ".")
  149.         IF P THEN ExeName$ = LEFT$ (ExeName$, P-1)
  150.         ExeName$ = LEFT$ (ExeName$, 8)
  151.         IF ExeName$ = BatName$ THEN
  152.           LOCATE 8,10
  153.           PRINT "THE FILE NAMES CAN'T BE THE SAME ";
  154.           PRINT "OR DOS WON'T KNOW WHICH ONE TO START !"
  155.           PLAY "O0 C4": DO: LOOP UNTIL INKEY$ <> ""
  156.           GOTO Start
  157.         END IF
  158.         ON ERROR GOTO Oops
  159.         OPEN BatName$ + ".BAT" FOR OUTPUT AS #1
  160.         PRINT #1, "echo off"
  161.         PRINT #1, ExeName$ + " " + L$
  162.         PRINT #1, ":   this batch file created by SETCOLOR.BAS to run " + ExeName$
  163.         CLOSE #1
  164.         ON ERROR GOTO 0
  165.         LOCATE 10,20: PRINT "FILE CREATED"
  166.       END IF
  167.       LOCATE 25,79
  168.       STOP
  169.  
  170.  END SELECT
  171.  
  172.  GOTO Start
  173.  
  174. DEF FnHEX2$ (N)
  175.  IF N < &H10 THEN FnHEX2$ = "0" + HEX$(N) ELSE FnHEX2$ = HEX$ (N)
  176. END DEF
  177. '      __________________________________________________________
  178.  
  179. GetChoice:
  180.  DO
  181.    IF F = B OR (F = 8 AND B = 0) THEN INCR F
  182.    COLOR 15,0
  183.    CALL GetUserColorChoice (F,B,val(Choice$))
  184.    COLOR F, B: LOCATE 16,20: PRINT F,B
  185.    IF F = B OR (F = 8 AND B = 0) THEN
  186.      LOCATE 11,10: COLOR 15,1: PLAY "O3 MS B16 G16"
  187.      PRINT " OOPS! Your combination,";F;"&";B;", is INVISIBLE. Try again ... "
  188.    ELSE
  189.      LOCATE 12,10: COLOR 0,0: PRINT SPACE$ (65)
  190.    END IF
  191.  LOOP WHILE F = B OR (F = 8 AND B = 0)
  192.  RETURN
  193.  
  194. SUB GetUserColorChoice(Fore%,Back%,Choice%)
  195. '                                     (c) 1988 Barry Erick
  196. '                                         used by presumption -- thanks
  197.  FirstY% = 2   'MAX is 17 MIN is 2
  198.  FirstX% = 3   'MAX is 16 MIN is 1
  199. ' CLS
  200.  Fore% = Fore% MOD 17
  201.  back% = back% MOD 9
  202.  If Fore% <0 THEN Fore% = 0
  203.  If Back% < 0 THEN Back% = 0
  204.  FirstY% = FirstY% MOD 18
  205.  IF FirstY%<2 THEN FirstY%=2
  206.  FirstX% = FirstX% MOD 17
  207.  IF FirstX%<1 THEN FirstX%=1
  208.  Title$ = "Move with "+CHR$(24)+CHR$(25)+CHR$(26)+CHR$(27)+"; <Enter> Selects"
  209.  Title$ = "BARRY'S COLOR CHART. " + Title$
  210.  LOCATE FirstY%-1,(32-(LEN(Title$)/2))
  211.  PRINT title$;
  212.  LOCATE FirstY%,FirstX%
  213.  FOR Y% = 0 TO 7
  214.      FOR X% = 0 TO 15
  215.          COLOR  X%,Y%
  216.          PRINT " XX ";
  217.      NEXT
  218.      LOCATE CSRLIN+1,FirstX%
  219.  NEXT
  220.  UsersFirstX%=(Fore%*4)+FirstX%
  221.  usersFirstY%=Back%+FirstY%
  222.  LOCATE UsersFirstY%,UsersFirstX%
  223.  Cline% = CSRLIN
  224.  Ps%=POS
  225.  Oldcline%=Cline%
  226.  Oldps%=Ps%
  227.  COLOR ((Ps%\4)-(FirstX%\4))+16,Cline%-FirstY%
  228.  PRINT " XX ";
  229.  
  230.  DO
  231.      WHILE NOT INSTAT:WEND
  232.      A$=INKEY$
  233.      IF LEN(A$)=1 THEN
  234.         SELECT CASE A$
  235.                CASE CHR$(13)
  236. ' this one
  237.                     Fore%=(Oldps%\4)-(FirstX%\4)
  238.                     Back%=Oldcline%-FirstY%
  239.                     IF FirstY%>13 THEN
  240.                        LOCATE 2,1
  241.                     ELSE
  242.                        LOCATE FirstY%+9,1
  243.                     END IF
  244.                     EXIT LOOP
  245.         END SELECT
  246.      ELSEIF LEN(A$)=2 THEN
  247.         SELECT CASE ASC(RIGHT$(A$,1))
  248.                CASE 72 'up arrow
  249.                     IF CSRLIN >FirstY% THEN
  250.                        DECR Cline%
  251.                     ELSE
  252.                        Cline% = 7 + FirstY%
  253.                     END IF
  254.                CASE 75 'left arrow
  255.                     IF POS >FirstX%+4 THEN
  256.                        DECR Ps%,4
  257.                     ELSE
  258.                        Ps% = FirstX% +60
  259.                     END IF
  260.                CASE 77 'right arrow
  261.                     IF POS <FirstX%+61 THEN
  262.                        INCR Ps%,4
  263.                     ELSE
  264.                        Ps% = FirstX%
  265.                     END IF
  266.                CASE 80 ' down arrow
  267.                     IF CSRLIN < FirstY%+7 THEN
  268.                        INCR Cline%
  269.                     ELSE
  270.                        Cline% = FirstY%
  271.                     END IF
  272.         END SELECT
  273.      END IF
  274.      LOCATE Oldcline%,Oldps%
  275.      COLOR ((Oldps%\4)-(FirstX%\4)),Oldcline% -FirstY%
  276.      PRINT " XX ";
  277.      pFore%=(ps%\4)-(FirstX%\4)
  278.      pBack%=cline%-FirstY%
  279.      SELECT CASE Choice%
  280.         CASE 1 : CALL ShowMenu(pFore%, pBack%)
  281.         CASE 2 : CALL ShowMenuBar(pFore%, pBack%)
  282.         CASE 3 : CALL ShowWin(pFore%, pBack%)
  283.         CASE 4 : CALL ShowData(pFore%, pBack%)
  284.         CASE 5 : CALL ShowMssgBox(pFore%, pBack%)
  285.         CASE 6 : CALL ShowBG(pFore%, pBack%)
  286.      END SELECT
  287.      COLOR ((Ps%\4)-(FirstX%\4))+16,Cline%-FirstY%
  288.      Oldcline% = Cline%
  289.      Oldps%=Ps%
  290.      LOCATE Cline%,Ps%
  291.      PRINT  " XX ";
  292.  LOOP
  293.  
  294. END SUB
  295.  
  296. Oops:
  297.  LOCATE 8,1: PRINT "ERROR OPENING FILE ";BatName$
  298.  PLAY "O0 C4": DO: LOOP UNTIL INKEY$ <> ""
  299.  RESUME Start
  300.  
  301. '----------------------
  302. SUB ShowMenu(Fore%,Back%)
  303. SHARED BarColor
  304.  COLOR Fore%, Back%
  305.  LOCATE 14,3: PRINT "╔═ sample menu ═╗"
  306.  LOCATE 15,3: PRINT "║ 1 - Machaut   ║"
  307.  LOCATE 16,3: PRINT "║ 2 - Lassus    ║"
  308.  LOCATE 17,3: PRINT "║ 3 - Des Prez  ║"
  309.  LOCATE 18,3: PRINT "║ 4 - Palestrina║"
  310.  LOCATE 19,3: PRINT "║ 5 - Holborne  ║"
  311.  LOCATE 20,3: PRINT "║ 6 - Tallis    ║"
  312.  LOCATE 21,3: PRINT "╚═══════════════╝"
  313.  CALL ShowMenuBar(BarColor MOD 16, BarColor \ 16)
  314. END SUB
  315.  
  316. SUB ShowMenuBar(Fore%,Back%)
  317.  COLOR Fore%,Back%
  318.  LOCATE 15,4: PRINT " 1 - Machaut   "
  319. END SUB
  320.  
  321. SUB ShowWin(Fore%,Back%)
  322.  COLOR Fore%,Back%
  323.  LOCATE 14,37: PRINT "╔═══════════════════════════════════╗
  324.  LOCATE 15,37: PRINT "║     SAMPLE DATA ENTRY WINDOW      ║
  325.  LOCATE 16,37: PRINT "║                                   ║
  326.  LOCATE 17,37: PRINT "║  Year: 1610    Form: Gaillard     ║
  327.  LOCATE 18,37: PRINT "╚═══════════════════════════════════╝
  328. END SUB
  329.  
  330. SUB ShowData(Fore%,Back%)
  331.  COLOR Fore%,Back%
  332.  LOCATE 17, 46: PRINT "1610"
  333.  LOCATE 17, 60: PRINT "Gaillard   "
  334. END SUB
  335.  
  336. SUB ShowMssgBox(Fore%, Back%)
  337.  COLOR Fore%, Back%
  338.  LOCATE 20,48: PRINT "╔═════════════════════╗
  339.  LOCATE 21,48: PRINT "║ SAMPLE MESSAGE BOX  ║
  340.  LOCATE 22,48: PRINT "╚═════════════════════╝
  341. END SUB
  342.  
  343. SUB ShowBG(Fore%,Back%)
  344.  COLOR Fore%, Back%
  345.  LOCATE 12,5: PRINT "THIS IS THE SCREEN BACKGROUND COLOR"
  346.  LOCATE 19,25: PRINT "╔══════╗
  347.  LOCATE 20,25: PRINT "║BUTTON║
  348.  LOCATE 21,25: PRINT "╚══════╝
  349. END SUB
  350.  
  351.